perm filename TEST1V.SAI[SAI,BGB] blob
sn#028610 filedate 1973-11-17 generic text, type T, neo UTF8
00100 BEGIN "TEST1V"
00200 REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00300 REQUIRE "RANDOM[SYS,BGB]" LOAD_MODULE;
00400 EXTERNAL REAL PROCEDURE RANDOM;
00500 REQUIRE "SAITRG[SYS,BGB]" SOURCE_FILE;
00600 EXTERNAL ITG PROCEDURE LS1V3P(REAL ARRAY V,P1,P2,P3,V3P);
00700
00800 α WORKING SPACE AND NAMINGS;
00900 INTEGER NROOTS,II,I;
01000 REAL L2,L3,R,RMIN,RXY,ERR,ERRMAX;
01100 REAL ARRAY P1,P2,P3,V3P[1:3],V[1:10,1:3];
01200 DEFINE X1="P1[1]",X2="P2[1]",X3="P3[1]";
01300 DEFINE Y2="P2[2]",Y3="P3[2]",Z3="P3[3]";
01400
01500 REAL PROCEDURE VERIFY (REAL X,Y,Z);
01600 BEGIN "VERIFY"
01700 DEFINE THRICE = "FOR I←1 STEP 1 UNTIL 3 DO";
01800 INTEGER I;
01900 REAL LA,LB,LC,CA,CB,CC;
02000 REAL ARRAY ALEG,BLEG,CLEG,L[1:3];
02100 L[1]←X;L[2]←Y;L[3]←Z;
02200 THRICE ALEG[I] ← P3[I] - L[I];
02300 THRICE BLEG[I] ← P1[I] - L[I];
02400 THRICE CLEG[I] ← P2[I] - L[I];
02500 LA ← SQRT(ALEG[1]↑2 + ALEG[2]↑2 + ALEG[3]↑2);
02600 LB ← SQRT(BLEG[1]↑2 + BLEG[2]↑2 + BLEG[3]↑2);
02700 LC ← SQRT(CLEG[1]↑2 + CLEG[2]↑2 + CLEG[3]↑2);
02800 CA ← (BLEG[1]*CLEG[1]+BLEG[2]*CLEG[2]+BLEG[3]*CLEG[3])/(LB*LC);
02900 CB ← (ALEG[1]*CLEG[1]+ALEG[2]*CLEG[2]+ALEG[3]*CLEG[3])/(LA*LC);
03000 CC ← (ALEG[1]*BLEG[1]+ALEG[2]*BLEG[2]+ALEG[3]*BLEG[3])/(LA*LB);
03100 ERR ← (ABS(CA-V3P[1]) + ABS(CB-V3P[2]) + ABS(CC-V3P[3]))/3;
03200 RETURN(ERR);
03300 END "VERIFY";
00100 α EXERCISE LOOP;
00200 FOR II←1 STEP 1 UNTIL 100 DO
00300 BEGIN "FOREVER"
00400 INTEGER TIME0,TIME1,TIMES;
00500
00600 α GENERATE A LANDMARK TRIANGLE;
00700 X1 ← 20*RANDOM + 1;
00800 X2 ← 20*RANDOM + 1;
00900 Y2 ← 20*RANDOM + 1;
01000 X3 ← 20*RANDOM + 1;
01100 Y3 ← 20*RANDOM + 1;
01200 Z3 ← 20*RANDOM + 1;
01300
01400 α COMPUTE THE COSINES AT THE CAMERA;
01500 L2 ← SQRT(X2↑2 + Y2↑2);
01600 L3 ← SQRT(X3↑2 + Y3↑2 + Z3↑2);
01700 V3P[3] ← X2 / L2;
01800 V3P[1] ← (X2*X3+Y2*Y3)/ (L2*L3);
01900 V3P[2] ← X3 / L3;
02000 V3P[2]↔V3P[3];V3P[1]↔V3P[2];
02100
02200 α THROW THE SHIT AT THE FAN;
02300 NROOTS ← LS1V3P (V,P3,P1,P2,V3P);
02400 RMIN ← 1000;
02500
02600 α OUTPUT THE RESULTS;
02700 IF NROOTS < 0 THEN OUTSTR(" NO ROOTS - GAP LOW.") ELSE
02800 IF NROOTS = 0 THEN OUTSTR(" NO ROOTS - GAP HIGH") ELSE
02900 FOR I←1 STEP 1 UNTIL NROOTS DO
03000 RMIN ← RMIN MIN SQRT(V[I,1]↑2+V[I,2]↑2+V[I,3]↑2);
03100 OUTSTR(CVG(RMIN)&9);
03200 IF RMIN>0.1 THEN
03300 ⊂ OUTSTR("LOSE"&↓);INCHRW;⊃
03400 ELSE OUTSTR("WIN"&↓);
03500 END "FOREVER";
03600 END "TEST1V"